home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue58 / Clinic / RunCmd.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-04-27  |  3.5 KB  |  132 lines
  1. unit RunCmd;
  2.  
  3. {$ifdef Ver90} { Delphi 2.0x }
  4.   {$define DelphiLessThan3}
  5. {$endif}
  6. {$ifdef Ver93} { C++ Builder 1.0x }
  7.   {$define DelphiLessThan3}
  8. {$endif}
  9.  
  10. interface
  11.  
  12. type
  13.   TWaitProc = procedure of object;
  14.   TBeforeWaitProc = TWaitProc;
  15.   TAfterWaitProc = TWaitProc;
  16.  
  17. procedure RunCommand(const Cmd, Params: String;
  18.   BeforeWait: TBeforeWaitProc;
  19.   AfterWait: TAfterWaitProc);
  20. //Extended version of RunCommand which can handle file associations
  21. procedure RunCommandEx(const Cmd, Params: String;
  22.   BeforeWait: TBeforeWaitProc;
  23.   AfterWait: TAfterWaitProc);
  24.  
  25. implementation
  26.  
  27. uses
  28.   SysUtils, Forms, ShellAPI, Windows;
  29.  
  30. {$ifdef DelphiLessThan3}
  31. type
  32.   EWin32Error = class(Exception)
  33.   public
  34.     ErrorCode: DWORD;
  35.   end;
  36.  
  37. procedure RaiseLastWin32Error;
  38. var
  39.   LastError: DWORD;
  40.   Error: EWin32Error;
  41. begin
  42.   LastError := GetLastError;
  43.   if LastError <> ERROR_SUCCESS then
  44.     Error := EWin32Error.CreateFmt('Win32 Error.  Code: %d.'#10'%s', [LastError, SysErrorMessage(LastError)])
  45.   else
  46.     Error := EWin32Error.Create('A Win32 API function failed');
  47.   Error.ErrorCode := LastError;
  48.   raise Error;
  49. end;
  50.  
  51. function Win32Check(RetVal: BOOL): BOOL;
  52. begin
  53.   if not RetVal then RaiseLastWin32Error;
  54.   Result := RetVal;
  55. end;
  56. {$endif}
  57.  
  58. procedure RunCommand(const Cmd, Params: String;
  59.   BeforeWait: TBeforeWaitProc;
  60.   AfterWait: TAfterWaitProc);
  61. var
  62.   SI: TStartupInfo;
  63.   PI: TProcessInformation;
  64.   CmdLine: String;
  65. begin
  66.   //Fill record with zero byte values
  67.   FillChar(SI, SizeOf(SI), 0);
  68.   //Set mandatory record field
  69.   SI.cb := SizeOf(SI);
  70.   //Ensure Windows mouse cursor reflects launch progress
  71.   SI.dwFlags := StartF_ForceOnFeedback;
  72.   //Set up command line
  73.   CmdLine := Cmd;
  74.   if Length(Params) > 0 then
  75.     CmdLine := CmdLine + #32 + Params;
  76.   //Try and launch child process. Raise exception on failure
  77.   Win32Check(
  78.     CreateProcess(
  79.       nil, PChar(CmdLine), nil, nil, False, 0, nil, nil, SI, PI));
  80.   try
  81.     //Wait until process has started its main message loop
  82.     WaitForInputIdle(PI.hProcess, Infinite);
  83.     if Assigned(BeforeWait) then
  84.       BeforeWait;
  85.     WaitForSingleObject(PI.hProcess, Infinite);
  86.     if Assigned(AfterWait) then
  87.       AfterWait;
  88.   finally
  89.     //Close process and thread handles
  90.     CloseHandle(PI.hThread);
  91.     CloseHandle(PI.hProcess);
  92.   end
  93. end;
  94.  
  95. //Extended version of RunCommand which can handle file associations
  96. procedure RunCommandEx(const Cmd, Params: String;
  97.   BeforeWait: TBeforeWaitProc;
  98.   AfterWait: TAfterWaitProc);
  99. var
  100.   SEI: TShellExecuteInfo;
  101. begin
  102.   //Fill record with zero byte values
  103.   FillChar(SEI, SizeOf(SEI), 0);
  104.   //Set mandatory record field
  105.   SEI.cbSize := SizeOf(SEI);
  106.   //Ask for an open process handle and no message boxes
  107.   SEI.fMask := see_Mask_NoCloseProcess or see_Mask_Flag_No_UI;
  108.   //Tell API which window any possible error dialogs should be modal to
  109.   SEI.Wnd := Application.Handle;
  110.   //Set up command line
  111.   SEI.lpFile := PChar(Cmd);
  112.   if Length(Params) > 0 then
  113.     SEI.lpParameters := PChar(Params);
  114.   SEI.nShow := sw_ShowNormal;
  115.   //Try and launch child process. Exit on failure
  116.   Win32Check(ShellExecuteEx(@SEI));
  117.   try
  118.     //Wait until process has started its main message loop
  119.     WaitForInputIdle(SEI.hProcess, Infinite);
  120.     if Assigned(BeforeWait) then
  121.       BeforeWait;
  122.     WaitForSingleObject(SEI.hProcess, Infinite);
  123.     if Assigned(AfterWait) then
  124.       AfterWait;
  125.   finally
  126.     //Close process handle
  127.     CloseHandle(SEI.hProcess);
  128.   end
  129. end;
  130.  
  131. end.
  132.